home *** CD-ROM | disk | FTP | other *** search
/ Acorn RISC PD-CD 1 / Acorn RISC PD-CD 1.iso / languages / perl / lib / termio < prev    next >
Encoding:
Text File  |  1990-06-20  |  1.1 KB  |  67 lines
  1. # Usage:
  2. #    $line = &termin();
  3. #    &termout($str1,$str2,...);
  4. #    $char = &getchar();
  5. #    &putchar($ch1,$ch2,...);
  6. #
  7. # Notes:
  8. #    1. &termin() leaves a trailing newline.
  9. #    2. &termin() gives undef on an error (eg escape)
  10. #    3. &termout() does not automatically append a newline.
  11. #    4. &termout() does not translate tabs.
  12. #    5. &getchar() does not echo.
  13. #    6. &putchar() translates "\n" or "\r" to a newline.
  14.  
  15. package termio;
  16.  
  17. sub main'termin {
  18.     local($buf) = ' ' x 255;
  19.     local($regs) = syscall("OS_ReadLine",$buf,255,32,127);
  20.  
  21.     if ($regs) {
  22.     local($len) = unpack('x4 I',$regs);
  23.     $buf = substr($buf,0,$len) . "\n";
  24.     $buf;
  25.     }
  26.     else {
  27.     undef;
  28.     }
  29. }
  30.  
  31. sub main'termout {
  32.     local ($_);
  33.  
  34.     foreach (@_) {
  35.     s/\n/\r\n/g;
  36.     syscall("OS_Write0",$_);
  37.     }
  38. }
  39.  
  40. sub main'getchar {
  41.     local ($ch) = syscall("OS_ReadC");
  42.  
  43.     if ($ch) {
  44.     $ch = unpack('I',$ch);
  45.     $ch = pack('C',$ch);
  46.     $ch;
  47.     }
  48.     else {
  49.     undef;
  50.     }
  51. }
  52.  
  53. sub main'putchar {
  54.     local($_);
  55.     foreach (@_) {
  56.     if ($_ eq "\n" || $_ eq "\r") {
  57.         syscall("OS_NewLine");
  58.     }
  59.     else {
  60.         $_ = ord($_);
  61.         syscall("OS_WriteC",$_);
  62.     }
  63.     }
  64. }
  65.  
  66. 1;
  67.